home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / jDXEngine 23886812001.psc / clsKeyboard.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-08-01  |  2.5 KB  |  102 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsKeyboard"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. 'Used for keyboard input
  17. Private DI As DirectInput8
  18. Private DIDevice As DirectInputDevice8
  19. Private DIState As DIKEYBOARDSTATE
  20. Private KeyState(0 To 255) As Boolean
  21. Private Const BufferSize As Long = 20
  22. Dim pBuffer(0 To 20) As DIDEVICEOBJECTDATA
  23.  
  24.  
  25. 'This will poll the keyboard for any keys pressed
  26. Public Sub GetKeys()
  27.     On Error GoTo error_h
  28.     
  29.     DIDevice.GetDeviceStateKeyboard DIState
  30.     On Error Resume Next
  31.     DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
  32.     
  33.     Exit Sub
  34. error_h:
  35.     Select Case ErrMsg(Err, "clsKeyboard.GetKeys")
  36.         Case vbRetry
  37.             Resume
  38.         Case vbIgnore
  39.             Resume Next
  40.         Case Else
  41.             Exit Sub
  42.     End Select
  43. End Sub
  44.  
  45. 'The initialization routine for the keyboard
  46. 'DX:       The DirectX8 object used by jDXEngine
  47. 'hWnd:     The handle to the window used to accept the keyboard input
  48. Public Sub Init(DX As DirectX8, hWnd As Long)
  49.     On Error GoTo error_h
  50.     
  51.     Dim I As Long
  52.     Dim DevProp As DIPROPLONG
  53.     Dim DevInfo As DirectInputDeviceInstance8
  54.     
  55.     Set DI = DX.DirectInputCreate
  56.     Set DIDevice = DI.CreateDevice("GUID_SysKeyboard")
  57.     
  58.     DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
  59.     DIDevice.SetCooperativeLevel hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
  60.     
  61.     DevProp.lHow = DIPH_DEVICE
  62.     DevProp.lData = BufferSize
  63.     
  64.     DIDevice.Acquire
  65.     
  66.     Exit Sub
  67. error_h:
  68.     Select Case ErrMsg(Err, "clsKeyboard.Init")
  69.         Case vbRetry
  70.             Resume
  71.         Case vbIgnore
  72.             Resume Next
  73.         Case Else
  74.             Exit Sub
  75.     End Select
  76. End Sub
  77.  
  78.  
  79. 'This function is used to determine if a specific key is pressed
  80. Public Function IsKeyDown(dxKeyCode As Long) As Boolean
  81.     On Error GoTo error_h
  82.     
  83.     If DIState.Key(dxKeyCode) Then
  84.         IsKeyDown = True
  85.     Else
  86.         IsKeyDown = False
  87.     End If
  88.     
  89.     Exit Function
  90. error_h:
  91.     Select Case ErrMsg(Err, "clsKeyboard.IsKeyDown(" & dxKeyCode & ")")
  92.         Case vbRetry
  93.             Resume
  94.         Case vbIgnore
  95.             Resume Next
  96.         Case Else
  97.             Exit Function
  98.     End Select
  99. End Function
  100.  
  101.  
  102.